home *** CD-ROM | disk | FTP | other *** search
- '***************************************************************************
- '**************** registration database api's ***********************
- '***************************************************************************
-
- '$DEFINE REG_DB_ENABLED
-
- const REG_SZ = 1
- const HKEY_CLASSES_ROOT = 1
- const ERROR_SUCCESS = 0
-
-
- DECLARE FUNCTION EercErrorHandler LIB "mscomstf.dll" (grc%, fVital%, sz1$, sz2$, sz3$) AS INTEGER
- CONST GRC_API_FAILED = 104
-
- DECLARE FUNCTION RegOpenKey LIB "SHELL.DLL" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
- DECLARE FUNCTION RegCreateKey LIB "shell.dll" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
- DECLARE FUNCTION RegDeleteKey LIB "shell.dll" (hKey&, szSubKey$) AS LONG
- DECLARE FUNCTION RegCloseKey LIB "shell.dll" (hKey&) AS LONG
- DECLARE FUNCTION RegQueryValue LIB "shell.dll" (hKey&, szSubKey$, szValue$, lpcb AS POINTER TO LONG) AS LONG
- DECLARE FUNCTION RegSetValue LIB "shell.dll" (hKey&, szSubKey$, dwType&, szValue$, cbValue&) AS LONG
- DECLARE FUNCTION RegEnumKey LIB "shell.dll" (HkEY&, dwIndex&, szBuffer$, dwBufferSize&) AS LONG
-
-
- DECLARE SUB CreateRegKey(szKey$)
- DECLARE SUB CreateRegKeyValue(szKey$, szValue$)
- DECLARE SUB SetRegKeyValue(szKey$, szValue$)
- DECLARE SUB DeleteRegKey(szKey$)
- DECLARE FUNCTION GetRegKeyValue(szKey$) AS STRING
- DECLARE FUNCTION DoesRegKeyExist(szKey$) AS INTEGER
-
-
- 'NOTE: All keys are assumed to be subkeys of HKEY_CLASSES_ROOT. Therefore,
- 'the key HKEY_CLASSES_ROOT\key1\key2 would simply be written as key1\key2
- 'for these api's.
-
-
- '**************************************************************************
- SUB CreateRegKey(szKey$) STATIC
- DIM phKey AS LONG
-
- IF RegCreateKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) > ERROR_SUCCESS THEN
- i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
- '$ifdef DEBUG
- StfApiErr saeFail, "CreateRegKey", szKey$
- '$endif ''DEBUG
- ERROR STFERR
- END IF
-
- IF RegCloseKey(phKey) > ERROR_SUCCESS THEN
- i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
- '$ifdef DEBUG
- StfApiErr saeFail, "CreateRegKey", szKey$
- '$endif ''DEBUG
- ERROR STFERR
- END IF
- END SUB
-
-
- '**************************************************************************
- SUB CreateRegKeyValue(szKey$, szValue$) STATIC
- DIM phKey AS LONG
-
- IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ, szValue$, len(szKey$)) > ERROR_SUCCESS THEN
- i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKeyValue", NULL, NULL)
- '$ifdef DEBUG
- StfApiErr saeFail, "CreateRegKeyValue", szKey$+", "+szValue$
- '$endif ''DEBUG
- ERROR STFERR
- END IF
- END SUB
-
-
- '**************************************************************************
- FUNCTION DoesRegKeyExist(szKey$) STATIC AS INTEGER
- DIM phKey AS LONG
-
- IF RegOpenKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) = ERROR_SUCCESS THEN
- i = RegCloseKey(phKey)
- DoesRegKeyExist = 1
- ELSE
- DoesRegKeyExist = 0
- ENDIF
- END FUNCTION
-
-
- '**************************************************************************
- SUB SetRegKeyValue(szKey$, szValue$) STATIC
- DIM phKey AS LONG
-
- IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ, szValue$, len(szKey$)) > ERROR_SUCCESS THEN
- i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
- '$ifdef DEBUG
- StfApiErr saeFail, "SetRegKeyValue", szKey$+", "+szValue$
- '$endif ''DEBUG
- ERROR STFERR
- END IF
- END SUB
-
-
- '**************************************************************************
- FUNCTION GetRegKeyValue(szKey$) STATIC AS STRING
- szValue$ = string$(512,32)
- cb& = len(szValue$)
-
- IF DoesRegKeyExist(szKey$) = 0 THEN
- GetRegKeyValue = ""
- EXIT FUNCTION
- END IF
-
- IF RegQueryValue(HKEY_CLASSES_ROOT, szKey$, szValue$, VARPTR(cb)) = ERROR_SUCCESS THEN
- GetRegKeyValue = MID$(szValue$, 1, cb)
- ELSE
- i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
- '$ifdef DEBUG
- StfApiErr saeFail, "GetRegKeyValue", szKey$
- '$endif ''DEBUG
- ERROR STFERR
- END IF
- szValue$ = ""
- END FUNCTION
-
-
- '**************************************************************************
- SUB DeleteRegKey(szKey$) STATIC
- i& = RegDeleteKey(HKEY_CLASSES_ROOT, szKey$)
- END SUB
-
-